home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Games Collection 1
/
software vault.zip
/
software vault
/
CDR10
/
SPX20.ZIP
/
SPX_DEMO.ZIP
/
DEMO04.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-09-24
|
3KB
|
128 lines
Program Demo4;
{ SPX library - GeoMorph demo Copyright 1993 Scott D. Ramsay }
Uses crt,spx_vga,spx_key,spx_geo,spx_txt,spx_fnc;
const
path = '';
gmx = 50; { tile map size }
gmy = 50;
gsx = 16; { tile size }
gsy = 16;
smx = gmx*gsx; { tile map size in pixels }
smy = gmy*gsy;
speed : integer = 4;
type
PMyMorph = ^TMyMorph;
TMyMorph = object(TMorph)
function geomap(x,y:integer):integer;virtual;
procedure placegeo(x,y,geonum:integer);virtual;
procedure nogogeo(x,y:integer); virtual;
end;
var
MyMorph : PMyMorph;
gpic : array[0..20] of pointer;
map : array[0..gmy-1,0..gmx-1] of byte;
pal : RGBlist;
flip,
geo_cnt,
x,y : integer;
procedure setup;
begin
openmode(2);
MyMorph := new(PMyMorph,init(gmx,gmy,21,14,0,0));
setpageactive(2);
geo_cnt := loadgmp(path+'demo.gmp',gpic,map);
loadcolors(path+'demo.pal',pal,256);
fsetcolors(pal);
x := 50; y := 50;
end;
procedure changexy;
begin
if np[7,2] or np[8,2] or np[9,2]
then dec(y,speed)
else
if np[1,2] or np[2,2] or np[3,2]
then inc(y,speed);
if np[7,2] or np[4,2] or np[1,2]
then dec(x,speed)
else
if np[9,2] or np[6,2] or np[3,2]
then inc(x,speed);
if ch in ['1'..'9']
then speed := vl(ch);
ifix(x,0,smx-1); ifix(y,0,smy-1);
end;
procedure Animate;
begin
flip := 0;
repeat
flip := (flip+1)mod 4;
changexy;
MyMorph^.drawmap(x,y);
putletter(25,20,5,st(x)+','+st(y));
putletter(24,19,255,st(x)+','+st(y));
putletter(25,27,5,'Speed = '+st(speed));
putletter(24,26,255,'Speed = '+st(speed));
pset(160,100,255);
pset(161,101,5);
pcopy(2,1);
until esc;
end;
(**) { TMyMorph methods }
function TMyMorph.geomap(x,y:integer):integer;
begin
geomap := map[y,x];
end;
procedure TMyMorph.nogogeo(x,y:integer);
begin
fput_clip(x,y,gpic[0]^,false);
end;
procedure TMyMorph.placegeo(x,y,geonum:integer);
begin
if geonum in [1..geo_cnt]
then
if geonum=2
then fput_clip(x,y,gpic[1+flip]^,false)
else fput_clip(x,y,gpic[geonum-1]^,false);
end;
procedure showit;
begin
clrscr;
writeln('SPX library - GeoMorph demo');
writeln('Copyright 1993 Scott D. Ramsay');
writeln;
writeln('Keys:');
writeln(' ESC - quit demo');
writeln(' Arrow keys - scroll');
writeln(' 0..9 - change speed');
writeln;
write('Press SPACE to continue.');
clearbuffer;
repeat until space;
end;
begin
showit;
setup;
Animate;
dispose(MyMorph,done);
closemode;
end.